perm filename CYCOMF[1,LMM]1 blob sn#031708 filedate 1973-03-27 generic text, type T, neo UTF8
(DE ORDPAIR (X1 X2)
        (IF (LEQ X1 X2) THEN (CONS X1 X2) ELSE (CONS X2 X1))))
))))))))

(DE EDGEMARK (EDG)
      (ORDPAIR (NODEMARK (NODE1 EDG)) (NODEMARK (NODE2 EDG)))))
  ))))))))))))


(DE LABEL1C (OBJECTS LABELS STRUC)
        (IF (ZEROP LABELS)
           THEN (LIST (LABELING UNLABELED = OBJECTS LSTRUC = STRUC))
         ELSEIF (EQUAL LABELS (SIZE OBJECTS))
           THEN (LIST (LABELING LABELED = OBJECTS LSTRUC = STRUC))
         ELSEIF (NODES? OBJECTS)
           THEN (LABELN (NODENUMS OBJECTS) LABELS STRUC)
         ELSEIF (EDGES? OBJECTS)
           THEN (LABELE (NODEPRS OBJECTS) LABELS STRUC)
         ELSEIF (MULTTYPE? OBJECTS)
           THEN (LABELMULT
                  (MULT OBJECTS)
                  (UNMULTED OBJECTS)
                  LABELS
                  STRUC)
         ELSE (LABELUNDEFINEDSTRUC OBJECTS LABELS STRUC))))
))))))))

(DE MAKEMULT (M OBJ)
        (IF (ZEROP M) THEN NIL
         ELSEIF (EQUAL M 1) THEN OBJ
         ELSE (MULTTYPE MULT = M UNMULTED = OBJ))))
  ))

(DE MAKENODES (NODES)
        (IF (NOT NODES) THEN NIL ELSE (NODETYPE NODENUMS = NODES))))
  ))

(DE MAKEEDGES (EDGES)
        (IF (NOT EDGES) THEN NIL ELSE (EDGETYPE NODEPRS = EDGES))))
  ))

(DE LABELMULT (MULTS UNMULTED LABELS STRUC)
        (FOR NEW P
          IN (NUMPARTITIONS LABELS (SIZE UNMULTED) 0 MULTS)
            AS NEW CLP IS (CLCREATE P)
              FOR NEW L IN (LABELM UNMULTED (CDRLIST CLP) STRUC)
                XLIST  (LABELING
                    FROM
                    L
                    LABELED
                    =
                    (FOR NEW X IN ** AS NEW PR IN CLP
                      COMBINE FIRST NIL
                         (MAKEMULT (CAR PR) X))
                    UNLABELED
                    =
                    (FOR NEW X IN (LABELED L) AS NEW PR IN CLP
                      COMBINE FIRST NIL
                         (MAKEMULT (DIFFERENCE MULTS (CAR PR)) X)))))
     )
  ))

(DE LABEL0A (OBJECTS STRUC NPL LABELS MAKEFN)
        (FOR NEW L
          IN (IF (NOT (REMPERMS NPL))
               THEN (COMB1 OBJECTS NIL NIL (OKPERMS NPL) LABELS)
             ELSE (COMB
                    OBJECTS
                    NIL
                    (DIFF (OBJ (CAR (REMPERMS NPL))) OBJECTS)
                    NPL
                    LABELS))
            XLIST  (LABELING
                FROM
                L
                LABELED
                =
                (MAKEFN **)
                UNLABELED
                =
                (MAKEFN (DIFF OBJECTS (LABELED L)))
                LSTRUC
                =
                (STRUCTURE FROM STRUC GROUP = (LSTRUC L))))))
  ))

(DE LABELN (NODENUMS LABELS STRUC)
        (LABEL0A
          NODENUMS
          STRUC
          (FINDGROUPNODES NODENUMS STRUC)
          LABELS
          (FUNCTION MAKENODES))))
  ))

(DE LABELE (EDGES LABELS STRUC)
        (LABEL0A
          EDGES
          STRUC
          (FINDGROUPEDGES EDGES STRUC)
          LABELS
          (FUNCTION MAKEEDGES))))
  ))

(DE UNCLASS (OBJECTS)
        (IF (NOT OBJECTS) THEN NIL
         ELSEIF (UNCLASSED? OBJECTS) THEN (OBJECTS OBJECTS)
         ELSEIF (NODES? OBJECTS) THEN (NODENUMS OBJECTS)
         ELSEIF (EDGES? OBJECTS) THEN (NODEPRS OBJECTS)
         ELSEIF (MULTTYPE? OBJECTS)
           THEN (FOR NEW M := (1 (MULT OBJECTS))
                  APPEND  (UNCLASS (UNMULTED OBJECTS)))
         ELSEIF (COMBINATION? OBJECTS)
           THEN (APPEND
                  (UNCLASS (OBJ1 OBJECTS))
                  (UNCLASS (OBJ2 OBJECTS)))
         ELSE (PRINT (CONS OBJECTS @(ERROR ARG TO UNCLASS))
              NIL)))
  ))

(DE LUNCLASS (LOBJ)
     (MAPCAR @ UNCLASS LOBJ))))
  ))